home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / swagd-f / files.swg / 0055_Remove Records from File.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  2.3 KB  |  71 lines
  1.  
  2. { The following procedure physically removes record(s) from any file,
  3.   then truncate the file. I use it to shrink log files and to remove
  4.   index entries from Squish .SQI files, but many other uses may be found.  }
  5.  
  6. { Donated to the public domain by Raphaël Vanney.                          }
  7.  
  8. Uses DOS ;
  9.  
  10. Function  DeleteRecs(    Var AFile ;
  11.                          From      : LongInt ;
  12.                          Count     : LongInt ;
  13.                          BufSize   : Word) : Integer ;
  14.  
  15. { AFile   : any typed or untyped file (not Text), must be opened           }
  16. { From    : number of 1st record to delete, 0-based                        }
  17. { Count   : number of record(s) to delete                                  }
  18. { BufSize : size of the buffer to allocate. Must be > record size          }
  19.  
  20. Var  Buffer    : Pointer ;              { pointer to buffer                }
  21.      Src       : LongInt ;              { source record pointer            }
  22.      Cnt       : LongInt ;              { scratch                          }
  23.      Last      : LongInt ;              { last record to move              }
  24.      f         : File Absolute AFile ;  { file we're going to work on      }
  25.      Err       : Integer ;              { error code                       }
  26.  
  27. Label
  28.      Sortie ;
  29.  
  30. Begin
  31.      Last:=FileSize(f) ;
  32.      Src:=From+Count ;
  33.      If Count>(Last-From) Then Count:=Last-From ;
  34.  
  35.      { check BufSize against FileRec(f).RecSize }
  36.      If (BufSize<FileRec(f).RecSize) Or
  37.         (MaxAvail<BufSize) Then
  38.      Begin
  39.           DeleteRecs:=1 ; { error }
  40.           Exit ;
  41.      End ;
  42.  
  43.      GetMem(Buffer, BufSize) ;
  44.  
  45.      While Src<Last Do
  46.      Begin
  47.           Cnt:=BufSize Div FileRec(f).RecSize ;
  48.           If (Src+Cnt)>Last Then Cnt:=Last-Src ;
  49.           Seek(f, Src) ;
  50.           BlockRead(f, Buffer^, Cnt) ;
  51.           { error check }
  52.           Err:=IOResult ;
  53.           If Err<>0 Then GoTo Sortie ;
  54.           Seek(f, From) ;
  55.           BlockWrite(f, Buffer^, Cnt) ;
  56.           { error check }
  57.           Err:=IOResult ;
  58.           If Err<>0 Then GoTo Sortie ;
  59.           Inc(Src, Cnt) ;
  60.           Inc(From, Cnt) ;
  61.      End ;
  62.  
  63.      Seek(f, Last-Count) ;
  64.      Truncate(f) ;
  65. Sortie:
  66.      DeleteRecs:=Err ;
  67.      FreeMem(Buffer, BufSize) ;
  68. End;
  69.  
  70. BEGIN
  71. END.